home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / cadence.zip / VOL1NO1.ZIP / 2TANLIN.LSP next >
Text File  |  1987-05-18  |  2KB  |  55 lines
  1.  
  2. (defun C:2tanlin ();v1.00
  3. ;(c) scott hull, 05-27-86
  4. ;SAH mechanical design (415) 343-4015
  5. ;draws a line tangent to two arcs or circles.
  6.  
  7.  (terpri)
  8.  
  9.  (defun *error* (st)
  10.       (princ "error: ")
  11.       (princ st)
  12.  (terpri))
  13.  
  14.  (setq pk1 (getpoint "select first tangent point: "))
  15.  (terpri)
  16.  (setq pk2 (getpoint "select second tangent point: "))
  17.  (setq cp1 (osnap pk1 "cen"))
  18.  (setq cp2 (osnap pk2 "cen"))
  19.  (if (<= (angle cp2 cp1) 0.0)
  20.       (progn (setq c1 cp2) (setq p1 pk2) (setq c2 cp1) (setq p2 pk1))
  21.       (progn (setq c1 cp1) (setq p1 pk1) (setq c2 cp2) (setq p2 pk2)))
  22.  
  23.  (setq dtc (distance c1 c2))
  24.  (setq ag12 (angle c1 c2))
  25.  (setq ag21 (angle c2 c1))
  26.  (setq ag1 (angle c1 p1))
  27.  (setq ag2 (angle c2 p2))
  28.  (if (and (< ag1 ag21) (> ag1 ag12))
  29.       (setq case1 1) (setq case1 2))
  30.  (if (and (< ag2 ag21) (> ag2 ag12))
  31.       (setq case2 3) (setq case2 4)) 
  32.  (setq case (* case1 case2))
  33.  
  34.  (setq r1 (distance c1 (osnap p1 "near")))
  35.  (setq r2 (distance c2 (osnap p2 "near")))
  36.  (if (or (= case 4) (= case 6))
  37.       (setq dtr (+ r1 r2))
  38.       (setq dtr (- r1 r2)))
  39.       (setq length (sqrt (- (* dtc dtc) (* dtr dtr))))
  40.  (if (or (= case 4) (= case 6))
  41.       (setq agx (atan (/ length dtr)))
  42.       (setq agx (atan (/ dtr length))))
  43.  (if (= case 8)
  44.       (setq ag12 (- (angle c1 c2) (/ pi 2))))
  45.  (if (= case 3)
  46.       (setq ag12 (+ (angle c1 c2) (/ pi 2))))
  47.  (if (or (= case 3) (= case 6))
  48.       (setq agt (- ag12 agx))
  49.       (setq agt (+ ag12 agx)))
  50.  
  51.  (setq st (polar c1 agt r1))
  52.  (setvar "cmdecho" 0)
  53.  (command "line" st "tan" p2 "")
  54.  (terpri))
  55.